home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
heaptrk.zip
/
HEAPTRAK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
4KB
|
110 lines
Unit HeapTrak;
{PROGRAM : HEAP TRAK V1.00 }
{WRITTEN : Sept. 3, 1988 }
{AUTHOR : Bruce E. Stemplewski }
{ACKNOWLEDGEMENTS : Kim Kokkonen, TurboPower Software }
{ for : Unit - GrabHeap July 18, 1988 }
{FUNCTION : Heap Trak is a handy tool to keep track of just about }
{ all action that occurs on the heap. }
{USE : To use Heap Trak just apply the USES HeapTrak state- }
{ ment in your main program. Heap Trak will create a }
{ file called POINTER.LST. If POINTER.LST already exits }
{ the file will be appended. The date,time and heap }
{ origin will be recorded. Any calls to NEW,GETMEM, }
{ DISPOSE and FREEMEM will be recorded in the file. }
{ }
{ Ptr Adr = value of pointer just created }
{ Size = amount of memory allocated }
{ G/F = }
{ G = GetMem or New occured }
{ F = FreeMem or Dispose occured }
{ Heap Ptr = location of the heap pointer }
{ Free Ptr = Location of the free pointer }
{ Max Av = MaxAvail }
{ Mem Av = MemAvail }
{COMMENT : You will need GRABHEAP form Turbo Power }
Interface
Uses GrabHeap,Hexx,Dates,Times;
Implementation
Var
TextFile : Text;
OldExit : Pointer;
{$f+}
Procedure HeapTrakExit;
Begin
ExitProc := OldExit;
SystemHeapControl;
Close(TextFile);
End;
Procedure TrakFreeMem(Var P : Pointer; Size : Word); Forward;
Procedure TrakGetMem(Var P : Pointer; Size : Word);
Begin
SystemHeapControl;
GetMem(P,Size);
Writeln(TextFile,' $',HexPtr(P),' ',Size:5,' G $',HexPtr(HeapPtr),' $',HexPtr(FreePtr),
' ',FreeMin:6,' ',MAXAVAIL:6,' ',MeMAvail:6);
CustomHeapControl(@TrakGetMem,@TrakFreeMem);
End;
Procedure TrakFreeMem(Var P : Pointer; Size : Word);
Begin
SystemHeapControl;
FreeMem(P,Size);
Writeln(TextFile,' $',HexPtr(P),' ',Size:5,' F $',HexPtr(HeapPtr),' $',HexPtr(FreePtr),
' ',FreeMin:6,' ',MAXAVAIL:6,' ',MeMAvail:6);
CustomHeapControl(@TrakGetMem,@TrakFreeMem);
End;
{$F-}
Begin
OldExit := ExitProc;
ExitProc := @HeapTrakExit;
{$I-}
Assign(TextFile,'POINTER.LST');
Append(TextFile);
{$I+}
If IOResult <> 0 then
Rewrite(TextFile);
CustomHeapControl(@TrakGetMem,@TrakFreeMem);
Writeln(TextFile); Writeln(TextFile);
Writeln(TextFile,' HEAP TRAK UNIT V1.00 by Bruce E. Stemplewski');
Writeln(TextFile,'----------------------------------------------------------------------------');
Writeln(TextFile);
Writeln(TextFile,' DATE: ',Date);
Writeln(TextFile,' TIME: ',TIME);
Writeln(TextFile);
Writeln(TextFile,' HeapOrg: $',HexPtr(HeapOrg));
Writeln(TextFile);
Writeln(TextFile,'----------------------------------------------------------------------------');
Writeln(TextFile,'Ptr Adr Size G/F Heap Ptr Free Ptr Free Min Max Av Mem Av');
Writeln(TextFile,'----------------------------------------------------------------------------');
End.